home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / input.tcl < prev    next >
Encoding:
Text File  |  1997-04-09  |  2.9 KB  |  91 lines
  1. ##############################################################################
  2. # $Id: input.tcl,v 1.2 1997/04/09 13:13:02 stewart Exp $
  3. #
  4. # input.tcl - procedures for prompting windowed string input
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:get_string {title target {value ""}} {
  26.     global vTcl
  27.     set tmpname .vTcl.[vTcl:rename $target]
  28.     set vTcl(x,$tmpname) ""
  29.     vTcl:string_window $title $tmpname $value
  30.     tkwait window $tmpname
  31.     return $vTcl(x,$tmpname)
  32. }
  33.  
  34. proc vTcl:set_string {base str} {
  35.     global vTcl
  36.     set vTcl(x,$base) $str
  37.     grab release $base
  38.     destroy $base
  39. }
  40.  
  41. proc vTcl:snarf_string {base} {
  42.     global vTcl
  43.     vTcl:set_string $base "[$base.ent18 get]"
  44. }
  45.  
  46. proc vTcl:string_window {title base {value ""}} {
  47.     toplevel $base
  48.     wm transient $base .vTcl
  49.     wm focusmodel $base passive
  50.     wm geometry $base 225x49+288+216
  51.     wm maxsize $base 500 870
  52.     wm minsize $base 225 1
  53.     wm overrideredirect $base 0
  54.     wm resizable $base 1 0
  55.     wm deiconify $base
  56.     wm title $base "$title"
  57.     entry $base.ent18 \
  58.         -cursor {}  
  59.     pack $base.ent18 \
  60.         -in $base -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  61.         -padx 0 -pady 0 -side top 
  62.     frame $base.fra19 \
  63.         -borderwidth 1 -height 30 -relief sunken -width 30 
  64.     pack $base.fra19 \
  65.         -in $base -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
  66.         -padx 0 -pady 0 -side top 
  67.     button $base.fra19.but20 \
  68.         -command "vTcl:snarf_string \{$base\}" \
  69.          -padx 9 \
  70.         -pady 3 -text OK -width 5 
  71.     pack $base.fra19.but20 \
  72.         -in $base.fra19 -anchor center -expand 1 -fill x -ipadx 0 \
  73.         -ipady 0 -padx 0 -pady 0 -side left 
  74.     button $base.fra19.but21 \
  75.         -command "
  76.             $base.ent18 delete 0 end
  77.             vTcl:set_string \{$base\} \{$value\}
  78.         " \
  79.          -padx 9 \
  80.         -pady 3 -text Cancel -width 5 
  81.     pack $base.fra19.but21 \
  82.         -in $base.fra19 -anchor center -expand 1 -fill x -ipadx 0 \
  83.         -ipady 0 -padx 0 -pady 0 -side left 
  84.     bind $base <Key-Return> "vTcl:snarf_string \{$base\}; break"
  85.     $base.ent18 insert end $value
  86.     update idletasks
  87.     focus $base.ent18
  88.     grab $base
  89. }
  90.  
  91.